home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PsL Monthly 1993 December
/
PSL Monthly Shareware CD-ROM (December 1993).iso
/
prgmming
/
dos
/
pascal
/
boi.exe
/
IOLIB.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-12-12
|
16KB
|
548 lines
{$D-}
{$S-}
{$V-}
Unit IOLib;
{ Part of BBS Onliner Interface }
{ Copyright (C) 1990 Andrew J. Mead
All Rights Reserved. }
{ BBS Onliner Interface contains
Async - low-level serial port communications interrupt handler
BOIDecl - BOI standard declarations
IOLib - standard console and port communications routines
IOSupp - extended character code processing for IOLib-ReadPortKey
GetCmBBS - command line parser
Support - common library functions and procedures }
{ Original version 7/1/90
Original release version 1.0 beta 9/5/90
Version 1.01 9/19/90 /Q quiet local mode switch added
Version 1.01b 9/20/90 realname usage added, /A Remote Access defined
Version 1.02 9/22/90 RA access removed, /Q switch fixed
Version 1.03 9/23/90 /A play it Again switch added
Version 1.10 9/24/90 /2, /F, /M, /H, /5, /6 switches added
Version 1.11 9/29/90 beta version of /B locked baud rate
Version 1.12 10/ 1/90 /P switch added
Version 1.13 10/10/90 /N switch added
Version 1.14 10/22/90 /B switch fixed, carrier dectect routines added
Version 1.15 10/25/90 internal reorginizations, /K added
Version 1.16 11/ 9/90 /K fixed, F-9 abort added.
Version 1.17 12/ 1/90 internal reorginizations.
Version 1.17b12/ 5/90 /P fixed, /O implemented
Version 1.18 12/ 9/90 /O,/P verified /1,/3 implemented.
Version 1.20 12/10/90 Initial Public Release.
}
INTERFACE
Uses
Dos;
{ Standard Functions }
Function MIN(a,b : word) : word;
Function MAX(a,b : word) : word;
{* Internal timing *}
Procedure TIMERSET(var basetime : longint); { initialize timer value }
Function GETTIMER( {boolean} { true if val seconds has passed }
var basetime : longint; { starting time }
val : word) { number of seconds }
: boolean;
{* file validation *}
Function EXIST(thisfile : pathstr) : boolean;
Function VALID(thisfile : pathstr) : boolean;
{ Memory Function }
Function KEYPRESSED : Boolean; { RAM - check keyboard buffer }
{ BIOS Functions }
Function READKEY : char; { BIOS - get key from keyboard buffer }
Function WHEREX : byte; { BIOS - get current cursor x position }
Function WHEREY : byte; { BIOS - get current cursor y position }
Procedure DELAY(ms : Word); { BIOS - CPU delay, 993 = 1 second }
{ ANSI Functions }
{ Input/Output string procedures }
Procedure SENDSTRING( { send string to output }
outstr : string; { string to output }
docr : boolean); { send CR/LF indicator }
Function INTSTR( { returns a string of the input integer }
val : longint; { value to convert }
isize : byte) : string; { padded size of the string }
Function REALSTR({ returns a string of the input real value }
rval : real; { value to convert }
rsize, { padded size of the string }
rdec : byte) : string; { number of decimal places in string }
Function PADSTR( { returns a right justified string }
pstr : string; { string to right justify }
psize : byte) : string; { size of string }
Procedure GETSTRING(var gstr : string); { all input chars upto next CR }
{ Housecleaning procedures }
Procedure SETPORT; { Initialize Async Communications }
Procedure ENDPORT; { Terminate Async Communications }
{ Positional/Attribute Functions }
Procedure GOTOPORTXY(x,y : byte); { Position cursor at given coordinates }
Procedure PORTCOLOR( { if docolor then set acolor else set bcolor }
acolor, { color text attributes }
bcolor : byte); { monochrome text attributes }
Procedure TEXTPORTCOLOR(color : byte); { set text attributes }
Procedure PORTBACKGROUND(color: byte); { set background attributes }
Procedure CLRPORTSCR; { clear current window }
Procedure CLRPORTEOL; { clear current line to End Of Line }
Procedure PORTWINDOW(x1,y1,x2,y2 : byte); { Set display Window }
Procedure PORTCOLUMNONE; { put cursor in column one on current line }
{ Basic Input function }
Function READPORTKEY : char; { get input character }
Function PORTKEYPRESSED : boolean; { character ready for processing }
{ reset function }
Procedure CLEARBUFFERS; { clear keyboard and port input buffers }
{ Advanced positional group }
Procedure SETPORTXY; { save current cursor position }
Procedure RESETPORTXY; { restore saved cursor position }
{ Timeout procedure }
Function LEFTTIME : integer; { remaing player time in minutes }
Procedure DOTIMEOUT(ringbell : boolean); { exit program due to inactivity }
IMPLEMENTATION
Uses
boidecl,
iosupp,
Async;
Const
null = #0;
bell = #7;
esc = #27;
f10 = #$44; {scan code}
basex : byte = 1;
basey : byte = 1;
tempx : byte = 1;
tempy : byte = 1;
endx : byte = 24;
endy : byte = 80;
Var
regs : registers;
textattr : word;
workstr : string;
Function MIN(a,b : word) : word;
begin {* fMin *}
if a < b then Min := a else Min := b
end; {* fMin *}
Function MAX(a,b : word) : word;
begin {* fMax *}
if a > b then Max := a else Max := b
end; {* fMax *}
Procedure TIMERSET(var basetime : longint);
begin {* TimerSet *}
move(memw[$40:$6C],basetime,4)
end; {* TimerSet *}
Function GETTIMER(var basetime : longint; val : word) : boolean;
var thistime : longint;
begin {* GetTimer *}
move(memw[$40:$6C],thistime,4);
GetTimer := trunc((thistime - basetime) / 18.2) > val;
end; {* GetTimer *}
Function EXIST(thisfile : pathstr) : boolean;
var
afile : file;
iocode : word;
begin {* fExist *}
assign(afile,thisfile);
{$I-}
reset(afile);
{$I+}
iocode := ioresult;
Exist := (iocode = 0);
if iocode = 0 then close(afile);
end; {* fExist *}
Function VALID(thisfile : pathstr) : boolean;
Var
afile : file;
check : boolean;
iocode : word;
begin {* fValid *}
if not Exist(thisfile) then
begin
assign(afile,thisfile);
{$I-}
rewrite(afile);
close(afile);
erase(afile);
{$I+}
iocode := ioresult;
Valid := (iocode = 0)
end
else Valid := true
end; {* fValid *}
Procedure DELAY(MS: Word);
begin {* Delay *}
with regs do
begin
ah := $86;
move(ms,cx,2);
Intr($15,regs)
end
end; {* Delay *}
Function KEYPRESSED : Boolean;
begin {* KeyPressed *}
Keypressed := MemW[$0040:$001C] <> MemW[$0040:$001A]
end; {* KeyPressed *}
Function READKEY : char;
var key : char;
begin {* fReadKey *}
setfunction := false;
with regs do
begin
repeat { wait until keypressed }
begin
ah := $01; { check to see if keyboard buffer is empty }
Intr($16,regs)
end
until flags and fzero = 0;
ah := $00; { get next keycode from keyboard buffer }
Intr($16,regs);
move(al,key,1);
if key = null then { if local keyboard has pressed a function }
begin { key, replace the #0 value with the scan }
setfunction := true; { code of the key pressed. }
move(ah,key,1)
end;
ReadKey := key
end
end; {* fReadKey *}
Function WHEREX : byte;
begin {* fWhereX *}
with regs do
begin
ah := $03;
bh := $00;
Intr($10,regs);
WhereX := dl + 2 - baseX
end
end; {* fWhereX *}
Function WHEREY : byte;
begin {* fWhereY *}
with regs do
begin
ah := $03;
bh := $00;
Intr($10,regs);
WhereY := dh + 2 - baseY
end
end; {* f